home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 26.zip / BS1 part 26 / AMOS compiler.adf / Files / Compiler.AMOS / Compiler.amosSourceCode < prev    next >
AMOS Source Code  |  1991-06-13  |  21KB  |  805 lines
  1. '----------------------------------  
  2. ' AMOS Compiler shell accessory
  3. '
  4. ' By Fran�ois Lionet 
  5. ' (c) Europress Software Ltd. 1991 
  6. '----------------------------------  
  7. '
  8. Global PATH$,DPATH$,PRAM$,CNAME$,FLAG$,FACC,CFLASH$
  9. '
  10. CNAME$="Compiler_Configuration"
  11. PRAM$="RAM:AMOS_Compiler_Temp"
  12. DPATH$=":AMOS_System"
  13. '
  14. ' Colour to flash when un-squashing compiled programs. >31 for no flash
  15. ' Read Welcome text file for more infos... 
  16. CFLASH$="-Z32"
  17. '
  18. ' Enough RAM?
  19. Close Workbench 
  20. Close Editor 
  21. Set Sprite Buffer 48
  22. If Chip Free+Fast Free<80*1024
  23.    Screen Open 0,640,24,2,Hires : Colour 1,$FFF : Curs Off 
  24.    Centre ">>> Sorry, the compiler needs at least 80 Kbytes free to run. <<<"
  25.    Print : Print : Centre "Press any key"
  26.    Wait Key : Edit 
  27. End If 
  28. '
  29. ' Get the directories
  30. On Error Proc _NO_DISC
  31. If Exist(PRAM$+"/"+CNAME$)
  32.    DPATH$=PRAM$
  33.    Open In 1,PRAM$+"/Compiler_Origin"
  34.    Input #1,PATH$
  35.    Close 
  36. End If 
  37. '  
  38. Break Off 
  39. Change Mouse 4+6
  40. _UNPACK_FADE[10,0,2]
  41. _UNPACK_ICONS
  42. _UNPACK_INFO
  43. _LOAD_CONFIGURATION
  44. _SET_ZONES
  45. For B=1 To 3
  46.    _ANIMATE_BUTTON[B,0]
  47. Next 
  48. NOINFO
  49. _RESET_COMPILE
  50. '
  51. ' Load ACmp program
  52. On Error Proc _FATAL_DISC_ERROR
  53. If Not Extension_5_00AE 
  54.    INFO['>>> Loading "ACmp" program <<<']
  55.    If PATH$<>""
  56.        Extension_5_0098 PATH$+"/ACmp"
  57.    Else 
  58.        Extension_5_0098 DPATH$+"/ACmp"
  59.    End If 
  60.    NOINFO
  61. End If 
  62. '
  63. ' Copy into ram-disc?
  64. _GETFLAG[5]
  65. If Param
  66.    If Exist("Ram:")
  67.       If DPATH$<>PRAM$
  68.          _COPY_FOLDER[DPATH$,PRAM$]
  69.          If Param
  70.             PATH$=Dir$ : C=Instr(PATH$,":") : PATH$=Left$(PATH$,C-1)+DPATH$
  71.             Open Out 1,PRAM$+"/Compiler_Origin"
  72.             Print #1,PATH$
  73.             Close 
  74.             DPATH$=PRAM$
  75.          End If 
  76.       End If 
  77.    End If 
  78. End If 
  79. '
  80. ' Menu loop
  81. Do 
  82.    Repeat 
  83.       Multi Wait 
  84.       Z=Mouse Zone
  85.       If Mouse Key=2
  86.          INFO[">>>"+Str$(Chip Free+Fast Free+17000)+" bytes free to compile. <<<"]
  87.          While Mouse Key=2 : Wend 
  88.          NOINFO
  89.          Wait 16
  90.       End If 
  91.    Until Z<>0 and Mouse Key=1
  92.    _ANIMATE_BUTTON[Z,-1]
  93.    While Mouse Key : Wend 
  94.    If Z=4 : _COMPILE : End If 
  95.    If Z=5 : _THEEND : End If 
  96. Loop 
  97. '
  98. Procedure _COMPILE
  99.    '
  100.    On Error Proc _GENERAL_DISC_ERROR
  101.    Resume Label _FINISH_COMPILE
  102.    '
  103.    _INIT_COMPILE
  104.    Screen Close 1
  105.    '
  106.    Do 
  107.       _GETFLAG[1] : C$=" -D"+Mid$(Str$(Param),2)
  108.       S$=Fsel$("*.AMOS","","Please choose program to compile.","QUIT to abort compilation.")
  109.       If S$="" : INFO[">>> Compilation cancelled. <<<"] : KWAIT : Goto _FINISH_COMPILE : End If 
  110.       '
  111.       _GETFLAG[2] : C$=C$+Mid$(Str$(Param),2)
  112.       D$=Fsel$("**","","Please choose destination file name.",'"OK" for default name.')
  113.       If D$=""
  114.          _GETFLAG[3]
  115.          If Upper$(Right$(S$,5))=".AMOS"
  116.             If Param<2
  117.                D$=Left$(S$,Len(S$)-5)
  118.             Else 
  119.                D$=Left$(S$,Len(S$)-5)+"_C.AMOS"
  120.             End If 
  121.          End If 
  122.       End If 
  123.       Exit If D$<>""
  124.       INFO[">>> Please choose a .AMOS program, or enter object name. <<<"]
  125.       KWAIT : NOINFO
  126.    Loop 
  127.    '
  128.    _GETFLAG[3] : TYPE=Param : If TYPE=2 : TYPE=3 : End If 
  129.    '  
  130.    C$='"'+S$+'"'+C$+" -O"+'"'+D$+'"'
  131.    _GETFLAG[10] : C$=C$+" -S"+Mid$(Str$(Param),2)
  132.    _GETFLAG[9] : C$=C$+" -E"+Mid$(Str$(Param),2)
  133.    _GETFLAG[8] : C$=C$+" -W"+Mid$(Str$(Param),2)
  134.    _GETFLAG[4] : If TYPE=1 : Add TYPE,1 : End If 
  135.    _GETFLAG[12] : If Param : C$=C$+" -L" : End If 
  136.    C$=C$+" -T"+Mid$(Str$(TYPE),2)
  137.    C$=C$+" -F"+DPATH$+"/"+" -C"+DPATH$+"/"+CNAME$
  138.    C$=C$+" "+CFLASH$
  139.    '
  140.    Timer=0 : Extension_5_006E C$,$12345678 : E$= Extension_5_0078 
  141.    T=Timer/50 : M=T/60 : S=T mod 60
  142.    '
  143.    If E$=""
  144.       SZ= Extension_5_00BE 
  145.       A$="Object size:"+Str$(SZ)+" bytes -"+Str$( Extension_5_00BE )+" instructions - Compiled in"
  146.       If M : A$=A$+Str$(M)+" M." : End If 
  147.       A$=A$+Str$(S)+" Second" : If S>1 : A$=A$+"s" : End If 
  148.       A$=A$+"."
  149.       INFO[A$]
  150.       _GETFLAG[11]
  151.       If Param<>0 and TYPE<>3
  152.          KWAIT
  153.          INFO[">>> Squashing program. Press CONTROL-C to cancel squashing <<<"]
  154.          DD$=D$+"_Temp"
  155.          _SQUASH_A_PROG[D$,DD$,1]
  156.          If Param>0
  157.             A$=">>> Successfull squash, final size:"+Str$(Param)+","+Str$(SZ-Param)+" bytes saved. <<<"
  158.             INFO[A$]
  159.          Else 
  160.             If Param=0
  161.                INFO[">>> Squash interrupted. <<<"]
  162.             End If 
  163.             If Param<0
  164.                INFO[">>> Un-successfull squash, no object file on disc. <<<"]
  165.             End If 
  166.          End If 
  167.          On Error Proc _SKIP_DISC_ERROR
  168.          Resume Label NOKIL1
  169.          Kill D$
  170.          NOKIL1:
  171.          Resume Label NOKIL2
  172.          Rename DD$ To D$
  173.          NOKIL2:
  174.       End If 
  175.    Else 
  176.       A$=">>> "+E$+" <<<" : INFO[A$]
  177.    End If 
  178.    KWAIT
  179.    '
  180.    _FINISH_COMPILE:
  181.    _UNPACK_ICONS
  182.    _RESET_COMPILE
  183.    NOINFO : Screen 0
  184. End Proc
  185. Procedure _NO_DISC
  186.    Screen Open 0,640,24,2,Hires : Colour 1,$FFF : Curs Off 
  187.    Centre "I cannot reach the crucial files from your disc,"
  188.    Print : Centre "please read the manual for more informations."
  189.    Print : Centre ">>> Press any key <<<"
  190.    Wait Key : Edit 
  191. End Proc
  192. Procedure _FATAL_DISC_ERROR
  193.    INFO[">>> Disc error: AMOS_System MUST be in the CURRENT drive. <<<"]
  194.    KWAIT
  195.    _THEEND
  196. End Proc
  197. Procedure _GENERAL_DISC_ERROR
  198.    Close 
  199.    INFO[">>> Disc error, check your disc drive and free space on disc. <<<"]
  200.    KWAIT
  201.    Resume Label 
  202. End Proc
  203. Procedure _SKIP_DISC_ERROR
  204.    Resume Label 
  205. End Proc
  206. Procedure _RESET_COMPILE
  207.    LX=72 : Y3=92
  208.    Bob Off 1 : Update 
  209.    Synchro On : Update On 
  210.    Make Mask 1
  211.    For X=0 To 9*23 Step 9
  212.       Paste Bob LX+X,Y3,1
  213.    Next 
  214.    Wait Vbl 
  215.    OX=192 : DX=16
  216.    Screen Copy 1,OX,34,OX+72,34+33 To 0,DX,Y3
  217. End Proc
  218. Procedure _INIT_COMPILE
  219.    OX=192 : DX=16 : Y3=92 : LX=72
  220.    For N=1 To 6 : Make Mask N : Next 
  221.    Wait Vbl : Screen Copy 1,OX,68,OX+72,68+33 To 0,DX,Y3
  222.    Set Bob 1,-1,, : Bob 1,LX,Y3,1
  223.    Channel 1 To Bob 1
  224.    A$=A$+"      Let RA=0; Let RB=0; Let R0=0; Let A=1;"
  225.    A$=A$+"Loop: If RA<>RB Jump More;"
  226.    A$=A$+"      Pause; Jump Loop;"
  227.    A$=A$+"More: Let R0=R0+1; If R0=6 Jump Plus;"
  228.    A$=A$+"      Let A=A+1; Jump Again;"
  229.    A$=A$+"Plus: Let R0=0; Let X=X+9; Let A=1;"
  230.    A$=A$+"Again:Let RB=RB+1; Pause;"
  231.    A$=A$+"      Jump Loop;"
  232.    Amal 1,A$
  233.    Amal On 
  234.    Wait 5
  235.    Synchro Off : Update Off 
  236. End Proc
  237. Procedure _LOAD_CONFIGURATION
  238.    On Error Proc _SKIP_DISC_ERROR
  239.    Resume Label NOLOAD
  240.    '
  241.    Do 
  242.       A$=">>> Cannot load configuration file. <<<"
  243.       If Exist(DPATH$+"/"+CNAME$)
  244.          A$=">>> Configuration file corrupted. <<<"
  245.          INFO[">>> Loading "+CNAME$+" <<<"]
  246.          Open In 1,DPATH$+"/"+CNAME$ : L=Lof(1) : Close 
  247.          Erase 9 : Reserve As Work 9,L
  248.          Bload DPATH$+"/"+CNAME$,Start(9)
  249.          CONF=Hunt(Start(9) To Start(9)+Length(9),"[")+1
  250.          If CONF
  251.             If Chr$(Peek(CONF+60))="]"
  252.                FLAG$=Space$(12)
  253.                For C=0 To Len(FLAG$)-1
  254.                   Poke Varptr(FLAG$)+C,Peek(CONF+C)
  255.                Next 
  256.                FLAG=True
  257.             End If 
  258.          End If 
  259.       End If 
  260.       Erase 9
  261.       Exit If FLAG
  262.       Goto KIPS
  263.       '
  264.       NOLOAD: A$=">>> Cannot load configuration file. <<<"
  265.       KIPS: INFO[A$] : KWAIT : NOINFO
  266.       CNAME$=Fsel$("Compiler_Configuratio**","","Please select a configuration to load.","Click on SET DIR before leaving.")
  267.       If CNAME$="" : _THEEND : End If 
  268.       _GET_DISCNAME[CNAME$] : CNAME$=Param$
  269.    Loop 
  270.    NOINFO
  271. End Proc
  272. Procedure _SAVE_CONFIGURATION
  273.    On Error Proc _GENERAL_DISC_ERROR
  274.    Resume Label _NOSAVE
  275.    '
  276.    If Exist(DPATH$+"/"+CNAME$)
  277.       Open In 1,DPATH$+"/"+CNAME$ : L=Lof(1) : Close 
  278.       Erase 9 : Reserve As Work 9,L
  279.       Bload DPATH$+"/"+CNAME$,Start(9)
  280.       CONF=Hunt(Start(9) To Start(9)+Length(9),"[")+1
  281.       For C=1 To Len(FLAG$)
  282.          Poke CONF,Asc(Mid$(FLAG$,C,1)) : Inc CONF
  283.       Next 
  284.       Bsave DPATH$+"/"+CNAME$,Start(9) To Start(9)+L
  285.       If PATH$<>""
  286.          Bsave PATH$+"/"+CNAME$,Start(9) To Start(9)+L
  287.       End If 
  288.       Erase 9
  289.       FLAG=True
  290.    End If 
  291.    _NOSAVE:
  292.    If FLAG=0
  293.       INFO[">>> Cannot save configuration file. <<<"]
  294.       KWAIT
  295.    End If 
  296. End Proc
  297. Procedure _GET_DISCNAME[N$]
  298.    For N=Len(N$) To 1 Step -1
  299.       A$=Mid$(N$,N,1)
  300.       Exit If(A$="/") or(A$=":")
  301.    Next 
  302.    N$=Mid$(N$,N+1)
  303. End Proc[N$]
  304. Procedure _GETFLAG[N]
  305. End Proc[Asc(Mid$(FLAG$,N,1))-48]
  306. Procedure _SETFLAG[N,V]
  307.    Mid$(FLAG$,N)=Chr$(48+V)
  308. End Proc
  309. Procedure _ANIMATE_BUTTON[Z,FLAG]
  310.    '
  311.    Shared _ORIGIN,_DEST,_TYPE
  312.    Y1=48 : Y2=134
  313.    '
  314.    On Z Gosub Z1,Z2,Z3,Z4,Z5,Z6,Z7
  315.    Pop Proc
  316.    '  
  317.    Z1:
  318.    If FLAG
  319.       _GETFLAG[1] : _SETFLAG[1,1-Param]
  320.    End If 
  321.    _GETFLAG[1] : OX=Param*64 : DX=16 : Goto ZZ
  322.    Z2:
  323.    If FLAG
  324.       _GETFLAG[2] : _SETFLAG[2,1-Param]
  325.    End If 
  326.    _GETFLAG[2] : OX=Param*64 : DX=128 : Goto ZZ
  327.    Z3:
  328.    If FLAG
  329.       _GETFLAG[3] : F=Param
  330.       Add F,1,0 To 2
  331.       _SETFLAG[3,F]
  332.    End If 
  333.    _GETFLAG[3] : OX=Param*64+128 : DX=240 : Goto ZZ
  334.    Z4: Return 
  335.    Z5: OX=0 : DX=16 : Goto CB
  336.    Z6: OX=64 : DX=128
  337.    Wait Vbl : Screen Copy 1,OX,68,OX+64,68+34 To 0,DX,Y2
  338.    Wait 10 : Wait Vbl 
  339.    Screen Copy 1,OX,34,OX+64,34+34 To 0,DX,Y2
  340.    '
  341.    Auto View Off : Unpack 13 To 2 : For N=0 To 31 : Colour N,0 : Next 
  342.    Screen Display 2,164,100,, : Screen To Back : Screen Hide 3
  343.    Auto View On : Wait Vbl 
  344.    Screen 0 : Fade 1 : Wait 16
  345.    Screen 2 : Screen To Front : Fade 1 To 1
  346.    KWAIT
  347.    Fade 1 : Wait 16 : Screen To Back 
  348.    Screen 0 : Fade 1 To 1 : Wait 16 : Screen Show 3
  349.    Screen Close 2
  350.    Wait Vbl : Screen Copy 1,OX,34,OX+64,34+34 To 0,DX,Y2
  351.    Return 
  352.    Z7: OX=128 : DX=240 : Gosub CB
  353.    _SETUP_MENU : Return 
  354.    '
  355.    ' Animates the clickable buttons 
  356.    CB:
  357.    Wait Vbl 
  358.    Screen Copy 1,OX,68,OX+64,68+34 To 0,DX,Y2
  359.    Wait 10 : Wait Vbl 
  360.    Screen Copy 1,OX,34,OX+64,34+34 To 0,DX,Y2
  361.    Return 
  362.    '
  363.    ' Animates the drop buttons  
  364.    ZZ:
  365.    Screen 1 : Get Bob 9,OX,0 To OX+63,33 : No Mask 9 : Screen 0
  366.    Set Bob 2,-1,, : Bob 2,DX,Y1-32,9 : Limit Bob 2,0,Y1 To 320,Y1+32 : Update 
  367.    Channel 2 To Bob 2
  368.    Amal 2,"Move 0,32,8; Move 0,-4,4; Move 0,4,4;"
  369.    Amal On : While Chanmv(2) : Wait Vbl : Wend 
  370.    Bob Off : Del Bob 9
  371.    Update 
  372.    Return 
  373. End Proc
  374. Procedure _THEEND
  375.    If DPATH$=PRAM$
  376.       _GETFLAG[6]
  377.       If Param=0
  378.          INFO[">>> Deleting compiler work folder from ram-disc <<<"]
  379.          _DELETE_FOLDER[PRAM$]
  380.          NOINFO : Wait 8
  381.       End If 
  382.    End If 
  383.    _GETFLAG[7] : If Param=0 : Extension_5_00A0 : End If 
  384.    Fade 1 : Wait 16
  385.    Screen Close 3
  386.    Screen Close 1
  387.    Screen Close 0
  388.    Edit 
  389. End Proc
  390. Procedure _DELETE_FOLDER[S$]
  391.    Dim FILE$(64),NC$(2)
  392.    On Error Proc _SKIP_DISC_ERROR
  393.    Resume Label _SKIP
  394.    '
  395.    Set Dir ,""
  396.    If Upper$(Left$(S$,4))<>"RAM:"
  397.       INFO[">>> Warning! I do not want to delete:"+S$+"! <<<"] : KWAIT
  398.    Else 
  399.       '
  400.       A$=Dir First$(S$+"/**")
  401.       While A$<>""
  402.          FILE$(N)=Left$(A$,30)-" " : Inc N
  403.          A$=Dir Next$
  404.       Wend 
  405.       If N
  406.          For C=0 To N-1
  407.             Kill S$+"/"+FILE$(C)
  408.          Next 
  409.       End If 
  410.       Kill S$
  411.    End If 
  412.    '
  413.    _SKIP:
  414. End Proc
  415. Procedure _COPY_FOLDER[S$,D$]
  416.    Dim FILE$(64),NC$(5)
  417.    On Error Proc _FATAL_DISC_ERROR
  418.    '
  419.    INFO[">>> Copying AMOS_System folder onto ram-disc. <<<"]
  420.    NC$(0)="W.LIB"
  421.    NC$(1)="ACMP"
  422.    NC$(2)="AMOS1_2_PAL.ENV"
  423.    NC$(3)="AMOS1_2_NTSC.ENV"
  424.    NC$(4)="AMOS1_2.ENV"
  425.    NC$(5)="COMPILER_CONFIGURATION.LARGE"
  426.    NCOP=5
  427.    Set Dir ,""
  428.    A$=Dir First$(S$+"/**")
  429.    While A$<>""
  430.       B$=Left$(A$,30)-" "
  431.       Do 
  432.          For NC=0 To NCOP
  433.             Exit If Upper$(B$)=NC$(NC),2
  434.          Next 
  435.          FILE$(N)=B$
  436.          TL=TL+Val(Mid$(A$,30))
  437.          Inc N
  438.          Exit 
  439.       Loop 
  440.       A$=Dir Next$
  441.    Wend 
  442.    If Chip Free+Fast Free<TL+100*1024
  443.       INFO[">>> Not enough free ram to copy libraries to the ram-disc. <<<"]
  444.       KWAIT
  445.       Goto _NORAM
  446.    End If 
  447.    Mkdir D$
  448.    If N
  449.       For C=0 To N-1
  450.          A$=S$+"/"+FILE$(C) : B$=D$+"/"+FILE$(C)
  451.          I$=">>> Copying: "+FILE$(C)+" to ram-disc <<<" : INFO[I$]
  452.          _FCOPY[A$,B$]
  453.       Next 
  454.    End If 
  455.    F=-1
  456.    _NORAM:
  457.    NOINFO
  458.    Set Dir ,".info/*.info/*.*.info"
  459. End Proc[F]
  460. Procedure _FCOPY[S$,D$]
  461.    On Error Proc _FATAL_DISC_ERROR
  462.    Open In 1,S$
  463.    Open Out 2,D$
  464.    LF=Lof(1)
  465.    Do 
  466.       Exit If P>=LF
  467.       L=Min(1024,LF-P)
  468.       A$=Input$(1,L)
  469.       Print #2,A$;
  470.       Add P,L
  471.    Loop 
  472.    Close 1
  473.    Close 2
  474. End Proc
  475. Procedure _SET_ZONES
  476.    NZ=7
  477.    Reserve Zone NZ
  478.    ' Set up zones 
  479.    For Z=1 To NZ
  480.       Read A,B,C,D : Set Zone Z,A,B To C,D
  481.    Next 
  482.    Data 16,48,79,80
  483.    Data 128,48,191,80
  484.    Data 240,48,303,80
  485.    Data 16,93,88,123
  486.    Data 16,134,79,166
  487.    Data 128,134,191,166
  488.    Data 240,134,303,166
  489. End Proc
  490. Procedure _UNPACK_ICONS
  491.    Auto View Off 
  492.    Unpack 12 To 1 : Screen Hide 1
  493.    Auto View On : _MOUSE_PALETTE
  494.    Screen 0
  495. End Proc
  496. Procedure _UNPACK_FADE[BK,SC,SP]
  497.    Dim C(31)
  498.    Auto View Off 
  499.    Unpack BK To SC : Screen Hide : _MOUSE_PALETTE : View : Wait Vbl 
  500.    For N=0 To 31
  501.       C(N)=Colour(N) : Colour N,0
  502.    Next 
  503.    Screen Show : View : Wait Vbl 
  504.    Fade SP,C(0),C(1),C(2),C(3),C(4),C(5),C(6),C(7),C(8),C(9),C(10),C(11),C(12),C(13),C(14),C(15),C(16),C(17),C(18),C(19)
  505.    Wait SP*16
  506.    _MOUSE_PALETTE
  507.    Auto View On 
  508. End Proc
  509. Procedure _UNPACK_INFO
  510.    Auto View Off 
  511.    Unpack 11 To 3 : Screen Hide 
  512.    Screen Display 3,,228,, : View 
  513.    _MOUSE_PALETTE : For N=0 To 15 : Colour N,0 : Next 
  514.    Screen Show 
  515.    Auto View On 
  516. End Proc
  517. Procedure _MOUSE_PALETTE
  518.    For C=16 To 31
  519.       Colour C,0
  520.    Next 
  521.    For C=16 To 24
  522.       Read CC
  523.       Colour C,CC
  524.    Next 
  525.    Data $0,$FFF,$FD0,$F90,$FC8,$DA4,$C70,$940,$F00
  526. End Proc
  527. Procedure _MAKE_SETUP_SCREEN
  528.    Fade 1 : Wait 16
  529.    Auto View Off 
  530.    Unpack 11 To 3 : Screen Hide 3 : _MOUSE_PALETTE
  531.    Screen Open 1,640,200,8,Hires
  532.    Curs Off : Flash Off : For C=0 To 31 : Colour C,0 : Next 
  533.    Screen Copy 3,0,0,640,8 To 1,0,0
  534.    For Y=8 To 192 Step 8
  535.       Screen Copy 3,0,9,640,9+8 To 1,0,Y
  536.    Next 
  537.    Screen Copy 3,0,21-8,640,21 To 1,0,192
  538.    Auto View On 
  539.    Fade 1 To 3
  540.    _UNPACK_INFO
  541.    Screen To Back 3
  542.    Screen 1
  543. End Proc
  544. Procedure _SETUP_MENU
  545.    Dim JMP$(64),ZIT(64),ITZ(64),ZBASE(64)
  546.    _MAKE_SETUP_SCREEN
  547.    Paper 6 : Pen 7 : Ink 5
  548.    PAGE=1
  549.    ' Handle menu
  550.    MK_MENU:
  551.    Curs Off : Gosub DR_MENU
  552.    NOZ=1
  553.    Do 
  554.       Repeat 
  555.          Multi Wait 
  556.          Z=Mouse Zone : K=Mouse Key
  557.          If Z<>OLDZ
  558.             If OLDZ>0 : ACT=-1 : IT=ZIT(OLDZ) : OLDZ=-1 : Gosub DR_ITEM : End If 
  559.             If Z>0 : OLDZ=Z : ACT=Z : IT=ZIT(Z) : ZNE=ZBASE(IT) : Gosub DR_ITEM : End If 
  560.          End If 
  561.       Until Z<>0 and K<>0
  562.       If JMP$(Z)<>"" : Gosub JMP$(Z) : End If 
  563.       ACT=Z : ZNE=ZBASE(IT) : Gosub DR_ITEM
  564.       If K=1 : Repeat : Multi Wait : Until Mouse Key=0 : End If 
  565.    Loop 
  566.    '  
  567.    MN_BACK:
  568.    Pop 
  569.    Fade 1 : Wait 16
  570.    _UNPACK_ICONS
  571.    Screen 0 : Fade 1 To 1
  572.    Pop Proc
  573.    '
  574.    MN_SAVE:
  575.    Timer=0
  576.    INFO[">>> Saving configuration file <<<"]
  577.    Wait 8 : Screen To Front 3 : Wait 8
  578.    _SAVE_CONFIGURATION
  579.    Repeat : Until Timer>50
  580.    Screen To Back 3
  581.    NOINFO
  582.    Screen 1
  583.    Return 
  584.    '
  585.    ST_FLAG: V=1-V : Gosub "POK"+VTYPE$ : Return 
  586.    ' Draw menu page 
  587.    DR_MENU:
  588.    Reserve Zone 64
  589.    IT=0 : ZNE=1 : NOZ=0 : ACT=-1 : OLDPAR=-1
  590.    Repeat 
  591.       Inc IT : ZBASE(IT)=ZNE : Gosub DR_ITEM
  592.    Until FLAG=False
  593.    Return 
  594.    ' Draw one menu item 
  595.    DR_ITEM:
  596.    LAB$="L"+(Str$(PAGE)-" ")+"_"+(Str$(IT)-" ")
  597.    On Error Goto NO_IT
  598.    Restore LAB$ : Read IT$
  599.    On Error 
  600.    M=0 : XX=-1
  601.    Repeat 
  602.       NEND=Instr(IT$,"|",M+1)
  603.       ENC=0 : LBL$="" : FL=0 : ZZ=0 : NB=0
  604.       Repeat 
  605.          N=M+1
  606.          M=Instr(IT$,",",N) : M2=Instr(IT$,":",N) : If M>M2 : M=0 : End If 
  607.          If M=0 or(NEND<>0 and M1>NEND) : M=M2 : FL=1 : End If 
  608.          A$=Upper$(Mid$(IT$,N,1)) : Inc N
  609.          If A$="E" : ENC=1 : End If 
  610.          If A$="L" : Gosub GT_STR : LBL$=A$ : Inc ZZ : End If 
  611.          If A$="C" : CNT=1 : End If 
  612.          If A$="X" : Gosub GT_STR : XX=Val(A$) : End If 
  613.          If A$="Y" : Gosub GT_STR : YY=Val(A$) : End If 
  614.       Until FL
  615.       If NEND
  616.          A$=Mid$(IT$,M+1,NEND-M-1)
  617.       Else 
  618.          A$=Mid$(IT$,M+1)
  619.       End If 
  620.       Gosub DR_WORD
  621.       M=NEND
  622.    Until NEND=0
  623.    FLAG=True
  624.    Return 
  625.    '
  626.    DR_WORD:
  627.    If XX<0 : XX=40-Len(A$)/2 : End If 
  628.    Locate XX,YY
  629.    '
  630.    FST=0
  631.    If Left$(A$,1)="&"
  632.       Inc FST
  633.       B$=Upper$(Mid$(A$,2,1)) : A$=Mid$(A$,3)
  634.       If B$="F"
  635.          Gosub GT_VAL
  636.          A$="  No   " : If V : A$="  Yes  " : End If 
  637.       End If 
  638.    End If 
  639.    '
  640.    X1=X Graphic(XX)-3 : Y1=Y Graphic(YY)-2 : X2=X Graphic(XX+Len(A$))+2 : Y2=Y1+11
  641.    '
  642.    If ZZ<>0 or NOZ=0 or FST<>0
  643.       Inverse Off : If ZZ<>0 and ACT=ZNE : Inverse On : End If 
  644.       Print A$;
  645.       If ENC<>0 and NOZ=0 : Box X1,Y1 To X2,Y2 : End If 
  646.    End If 
  647.    If ZZ<>0
  648.       If NOZ=0
  649.          Set Zone ZNE,X1,Y1 To X2,Y2
  650.          ZIT(ZNE)=IT : ITZ(IT)=ZNE
  651.          If LBL$<>""
  652.             JMP$(ZNE)=LBL$
  653.          End If 
  654.       End If 
  655.       Inc ZNE
  656.    End If 
  657.    XX=XX+(X2-X1)/8+1
  658.    Return 
  659.    '
  660.    NO_IT: Resume NO_IT2
  661.    NO_IT2: FLAG=False
  662.    Return 
  663.    '
  664.    GT_STR:
  665.    A$=Mid$(IT$,N,M-N)
  666.    Return 
  667.    '
  668.    GT_VAL:
  669.    VTYPE$=Left$(A$,1) : ADV=Val(Mid$(A$,2))
  670.    Goto "PIK"+VTYPE$
  671.    PIKF: _GETFLAG[ADV] : V=Param : Return 
  672.    POKF: _SETFLAG[ADV,V] : Return 
  673.    '
  674.    ' Datas page 1 
  675.    L1_1: Data "C,Y1,E:         Compiled program setup         "
  676.    L1_2: Data "Y3,X6:- Include error messages?|X66,E,LSt_Flag:&FF09"
  677.    L1_3: Data "Y5,X6:- Create default screen?|X66,E,LSt_Flag:&FF10"
  678.    L1_4: Data "Y7,X6:- Send AMOS TO BACK upon booting?|X66,E,LSt_Flag:&FF08"
  679.    L1_5: Data "Y9,X6:- CLI programs to run in the background?|X66,E,LSt_Flag:&FF04"
  680.    L1_6: Data "Y11,X6:- Long forward jumps (option -L for VERY long programs)?|X66,E,LSt_Flag:&FF12"
  681.    L1_7: Data "C,Y13,E:             Compiler setup             "
  682.    L1_8: Data "Y15,X6:- Copy all libraries onto ram-disc?|X66,E,LSt_Flag:&FF05"
  683.    L1_9: Data "Y17,X6:- Leave libraries on ram-disc upon exiting?|X66,E,LSt_Flag:&FF06"
  684.    L1_10: Data 'Y19,X6:- Keep compiler program "ACmp" in memory upon exiting?|X66,E,LSt_Flag:&FF07'
  685.    L1_11: Data "Y21,X6:- Squash compiled program?|X66,E,LSt_Flag:&FF11"
  686.    L1_12: Data "E,X72,Y23,LMn_Back: Exit "
  687.    L1_13: Data "E,X45,Y23,LMn_Save: Save this configuration "
  688. End Proc
  689. Procedure _SQUASH_A_PROG[S$,D$,FIRST]
  690.    '
  691.    On Error Proc _GENERAL_DISC_ERROR
  692.    Resume Label SQERROR
  693.    '
  694.    Open In 1,S$
  695.    Open Out 2,D$
  696.    '
  697.    HEAD1$=Input$(1,12)
  698.    NHUNK=Leek(Varptr(HEAD1$)+8)
  699.    HEAD2$=Input$(1,4*(2+NHUNK))
  700.    '
  701.    Print #2,HEAD1$;
  702.    Print #2,HEAD2$;
  703.    '
  704.    For H=0 To NHUNK-1
  705.       FLAG=True : If FIRST<>0 and H=0 and NHUNK>1 : FLAG=0 : End If 
  706.       Gosub SQHUNK
  707.       Exit If BRK
  708.       Loke Varptr(HEAD2$)+4*(2+H),HH
  709.    Next 
  710.    '
  711.    If BRK=0
  712.       Pof(2)=12
  713.       Print #2,HEAD2$;
  714.       LPROG=Lof(2)
  715.       Close 
  716.    Else 
  717.       Close 
  718.       Kill D$
  719.       LPROG=0
  720.    End If 
  721.    Goto SQEND
  722.    '
  723.    SQERROR:
  724.    On Error Proc _SKIP_DISC_ERROR
  725.    Resume Label KK
  726.    Kill D$
  727.    KK: LPROG=-1
  728.    Goto SQEND
  729.    '
  730.    SQHUNK:
  731.    H$=Input$(1,8) : Pof(1)=Pof(1)-8
  732.    HH=Leek(Varptr(H$)) and $C0000000
  733.    LP=Leek(Varptr(H$)+4) : HH=HH or LP : Rol.l 2,LP
  734.    Add LP,8+4
  735.    F=0
  736.    '
  737.    Erase 8 : Reserve As Work 8,LP+16
  738.    '
  739.    OLDPOF=Pof(1)
  740.    '
  741.    _ONCE_AGAIN:
  742.    AP=Start(8) : P=0
  743.    Repeat 
  744.       L=2048 : If P+L>LP : L=LP-P : End If 
  745.       A$=Input$(1,L)
  746.       Copy Varptr(A$),Varptr(A$)+L To AP
  747.       Add P,L : Add AP,L
  748.    Until P>=LP
  749.    '
  750.    AP=Start(8)
  751.    '
  752.    If FLAG<>0 and F=0
  753.       If Leek(AP)<>$78566467
  754.          '
  755.          L= Extension_5_00CE(AP+8,LP-12,-1,512,17)
  756.          If L=-1
  757.             Pof(1)=OLDPOF : F=-1 : Goto _ONCE_AGAIN
  758.          End If 
  759.          If L=-2 : BRK=-1 : Goto _ABORT : End If 
  760.          '  
  761.          LH=(L+3) and $FFFFFFFC
  762.          Copy AP+8,AP+8+LH To AP+8+12
  763.          Loke AP+8,$78566467 : Loke AP+12,LP : Loke AP+16,L
  764.          Add LH,12 : Loke AP+4,LH/4
  765.          HH=(HH and $C0000000) or(LH/4)
  766.          Loke AP+8+LH,$3F2
  767.          LP=8+LH+4
  768.       End If 
  769.    End If 
  770.    '
  771.    A$=Space$(2048) : P=0
  772.    Repeat 
  773.       L=2048 : If P+L>LP : L=LP-P : End If 
  774.       Copy AP,AP+L To Varptr(A$)
  775.       Print #2,Left$(A$,L);
  776.       Add P,L : Add AP,L
  777.    Until P>=LP
  778.    '
  779.    _ABORT:
  780.    Erase 8
  781.    Return 
  782.    '
  783.    SQEND:
  784. End Proc[LPROG]
  785. Procedure INFO[A$]
  786.    Screen 3
  787.    Ink 6 : Bar 6,4 To Screen Width-8,Screen Height-4
  788.    Ink 7,6 : L=Text Length(A$) : Text 320-L/2,12,A$
  789.    _MOUSE_PALETTE : Fade 1,$0,$F00,$E60,$DA0,$DA0,$DD0,$C,$EEE : Wait 8
  790.    Screen 0
  791. End Proc
  792. Procedure NOINFO
  793.    Screen 3 : Fade 1,0,0,0,0,0,0,0,0 : Wait 8 : Screen 0
  794. End Proc
  795. Procedure KWAIT
  796.    Bell 
  797.    Update On : Hide On 
  798.    Repeat 
  799.       Sprite 8,X Mouse,Y Mouse,8
  800.       Multi Wait 
  801.    Until Mouse Key
  802.    While Mouse Key : Wend 
  803.    Sprite Off : Wait Vbl 
  804.    Show On 
  805. End Proc